home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / PGUIDE / ERRORS / ERRORS.BAS next >
Encoding:
BASIC Source File  |  1996-10-15  |  2.8 KB  |  69 lines
  1. Attribute VB_Name = "Errors"
  2. Option Explicit
  3. Const mnErrDeviceUnavailable = 68
  4. Const mnErrDiskNotReady = 71
  5. Const mnErrDeviceIO = 57
  6. Const mnErrDiskFull = 61
  7. Const mnErrBadFileName = 64
  8. Const mnErrBadFileNameOrNumber = 52
  9. Const mnErrPathDoesNotExist = 76
  10. Const mnErrBadFileMode = 54
  11. Const mnErrFileAlreadyOpen = 55
  12. Const mnErrInputPastEndOfFile = 62
  13. Function FileErrors() As Integer
  14.     Dim intMsgType As Integer
  15.     Dim strMsg As String
  16.     Dim intResponse As Integer
  17.     ' Return Value      Meaning
  18.     ' 0                 Resume
  19.     ' 1                 Resume Next
  20.     ' 2                 Unrecoverable error
  21.     ' 3                 Unrecognized error
  22.     intMsgType = vbExclamation
  23.     Select Case Err.Number
  24.         Case mnErrDeviceUnavailable             ' Error 68
  25.             strMsg = "That device appears unavailable."
  26.             intMsgType = vbExclamation + vbOKCancel
  27.         Case mnErrDiskNotReady                  ' Error 71
  28.             strMsg = "Insert a disk in the drive and close the door."
  29.             intMsgType = vbExclamation + vbOKCancel
  30.         Case mnErrDeviceIO                      ' Error 57
  31.             strMsg = "Internal disk error."
  32.             intMsgType = vbExclamation + vbOKOnly
  33.         Case mnErrDiskFull                      ' Error 61
  34.             strMsg = "Disk is full. Continue?"
  35.             intMsgType = vbExclamation + vbAbortRetryIgnore
  36.         Case mnErrBadFileName, mnErrBadFileNameOrNumber ' Error 64 & 52
  37.             strMsg = "That filename is illegal."
  38.             intMsgType = vbExclamation + vbOKCancel
  39.         Case mnErrPathDoesNotExist                ' Error 76
  40.             strMsg = "That path doesn't exist."
  41.             intMsgType = vbExclamation + vbOKCancel
  42.         Case mnErrBadFileMode                     ' Error 54
  43.             strMsg = "Can't open your file for that type of access."
  44.         Case mnErrFileAlreadyOpen             ' Error 55
  45.             strMsg = "This file is already open."
  46.             intMsgType = vbExclamation + vbOKOnly
  47.         Case mnErrInputPastEndOfFile              ' Error 62
  48.             strMsg = "This file has a nonstandard end-of-file marker, "
  49.             strMsg = strMsg & "or an attempt was made to read beyond "
  50.             strMsg = strMsg & "the end-of-file marker."
  51.             intMsgType = vbExclamation + vbAbortRetryIgnore
  52.         Case Else
  53.             FileErrors = 3
  54.             Exit Function
  55.     End Select
  56.     intResponse = MsgBox(strMsg, intMsgType, "Disk Error")
  57.     Select Case intResponse
  58.         Case 1, 4       ' OK, Retry buttons.
  59.             FileErrors = 0
  60.         Case 2, 5       ' Cancel, Ignore buttons.
  61.             FileErrors = 1
  62.         Case 3          ' Abort button.
  63.             FileErrors = 2
  64.         Case Else
  65.             FileErrors = 3
  66.     End Select
  67. End Function
  68.  
  69.